1. Adjust the quantities with ARIMA
  2. Use residuals to measure correlations between two media outlets: \(\text{corr}_{ij}\)
  3. Calculte dissimilarity as: \(d_{ij} = 1-\text{corr}_{ij}\)
  4. Agglomerative hierarchical clustering using the dissimilarity measure \(d_{ij}\)
  5. Define a cutof value

Data

df %>% 
  group_by(Gattung, Titel, Verlag) %>%
  tally() %>%
  knitr::kable(align="l")
Gattung Titel Verlag n
14-tägliche Frauenzeitschriften Brigitte Gruner + Jahr GmbH & Co KG 339
14-tägliche Frauenzeitschriften freundin Hubert Burda Media 336
14-tägliche Frauenzeitschriften FÜR SIE Jahreszeiten Verlag GmbH 336
Aktuelle Zeitschriften und Magazine Bild am Sonntag Axel Springer SE 590
Aktuelle Zeitschriften und Magazine BUNTE Hubert Burda Media 679
Aktuelle Zeitschriften und Magazine Der Spiegel Spiegel-Verlag Rudolf Augstein GmbH & Co. KG 679
Aktuelle Zeitschriften und Magazine FOCUS Hubert Burda Media 673
Aktuelle Zeitschriften und Magazine Gala Gruner + Jahr GmbH & Co KG 674
Aktuelle Zeitschriften und Magazine Grazia Gruner + Jahr GmbH & Co KG 146
Aktuelle Zeitschriften und Magazine InTouch Bauer Advertising KG 370
Aktuelle Zeitschriften und Magazine NEON Gruner + Jahr GmbH & Co KG 125
Aktuelle Zeitschriften und Magazine Stern Gruner + Jahr GmbH & Co KG 679
Aktuelle Zeitschriften und Magazine SUPERillu Hubert Burda Media 679
Elternzeitschriften Eltern Gruner + Jahr GmbH & Co KG 103
Elternzeitschriften Eltern family Gruner + Jahr GmbH & Co KG 103
Esszeitschriften ARD Buffet Magazin Hubert Burda Media 126
Esszeitschriften DER FEINSCHMECKER Jahreszeiten Verlag GmbH 120
Esszeitschriften ESSEN & TRINKEN Gruner + Jahr GmbH & Co KG 157
Esszeitschriften ESSEN & TRINKEN FÜR JEDEN TAG Gruner + Jahr GmbH & Co KG 96
Esszeitschriften kochen & genießen Bauer Advertising KG 157
Esszeitschriften Lisa Kochen & Backen Hubert Burda Media 157
Esszeitschriften Lust auf Genuss Hubert Burda Media 166
Esszeitschriften meine Familie & ich Hubert Burda Media 166
Esszeitschriften tina Koch&Back-Ideen Bauer Advertising KG 129
Jugendzeitschriften BRAVO Bauer Advertising KG 626
Jugendzeitschriften BRAVO GiRL! Bauer Advertising KG 320
Kinderzeitschriften Dein Spiegel Spiegel-Verlag Rudolf Augstein GmbH & Co. KG 46
Kinderzeitschriften GEOlino Gruner + Jahr GmbH & Co KG 143
Kombinationen Tina Plus Bauer Advertising KG 420
Lifestylemagazine cinema Hubert Burda Media 151
Lifestylemagazine FIT FOR FUN Hubert Burda Media 157
Lifestylemagazine Playboy Hubert Burda Media 147
Monatliche Frauenzeitschriften burda style Hubert Burda Media 157
Monatliche Frauenzeitschriften Cosmopolitan Bauer Advertising KG 157
Monatliche Frauenzeitschriften ELLE Hubert Burda Media 157
Monatliche Frauenzeitschriften Glamour Condé Nast Verlag GmbH 195
Monatliche Frauenzeitschriften InStyle Hubert Burda Media 157
Monatliche Frauenzeitschriften Joy Bauer Advertising KG 157
Monatliche Frauenzeitschriften Maxi Bauer Advertising KG 157
Monatliche Frauenzeitschriften myself Condé Nast Verlag GmbH 91
Monatliche Frauenzeitschriften PETRA Jahreszeiten Verlag GmbH 157
Monatliche Frauenzeitschriften Shape Bauer Advertising KG 153
Monatliche Frauenzeitschriften VITAL Jahreszeiten Verlag GmbH 157
Monatliche Frauenzeitschriften Vogue Condé Nast Verlag GmbH 157
Motorpresse Auto Bild Axel Springer Auto Verlag GmbH 474
Motorpresse Auto Bild Klassik Axel Springer Auto Verlag GmbH 31
Motorpresse AUTO ZEITUNG Bauer Advertising KG 336
Programmzeitschriften auf einen Blick Bauer Advertising KG 679
Programmzeitschriften Fernsehwoche Bauer Advertising KG 679
Programmzeitschriften tv Hören und Sehen Bauer Advertising KG 679
Programmzeitschriften TV klar Bauer Advertising KG 561
Programmzeitschriften TV Movie Bauer Advertising KG 341
Programmzeitschriften tv pur Bauer Advertising KG 141
Programmzeitschriften TV Schlau Hubert Burda Media 118
Programmzeitschriften TV Spielfilm Hubert Burda Media 309
Programmzeitschriften TV SPIELFILM plus Hubert Burda Media 287
Programmzeitschriften TV Today Hubert Burda Media 312
Programmzeitschriften tv14 Bauer Advertising KG 340
Reisezeitschriften GEO Saison Gruner + Jahr GmbH & Co KG 134
Sportzeitschriften BRAVO Sport Bauer Advertising KG 344
Sportzeitschriften Sport Bild Axel Springer Sport Verlag GmbH 473
Wirtschaftspresse Capital Gruner + Jahr GmbH & Co KG 147
Wirtschaftspresse FOCUS-MONEY Hubert Burda Media 505
Wirtschaftspresse Guter Rat Hubert Burda Media 157
Wirtschaftspresse Harvard Business Manager Spiegel-Verlag Rudolf Augstein GmbH & Co. KG 140
Wirtschaftspresse manager magazin Spiegel-Verlag Rudolf Augstein GmbH & Co. KG 140
Wissensmagazine art Gruner + Jahr GmbH & Co KG 87
Wissensmagazine GEO Gruner + Jahr GmbH & Co KG 144
Wissensmagazine National Geographic Deutschland Gruner + Jahr GmbH & Co KG 143
Wissensmagazine P.M. Magazin Gruner + Jahr GmbH & Co KG 68
wöchentliche Frauenzeitschriften Alles für die Frau Bauer Advertising KG 601
wöchentliche Frauenzeitschriften Avanti Bauer Advertising KG 560
wöchentliche Frauenzeitschriften bella Bauer Advertising KG 679
wöchentliche Frauenzeitschriften DAS NEUE Bauer Advertising KG 560
wöchentliche Frauenzeitschriften DAS NEUE BLATT Bauer Advertising KG 679
wöchentliche Frauenzeitschriften Frau im Trend Hubert Burda Media 665
wöchentliche Frauenzeitschriften FREIZEIT REVUE Hubert Burda Media 678
wöchentliche Frauenzeitschriften FREIZEIT SPASS Hubert Burda Media 612
wöchentliche Frauenzeitschriften FREIZEITWOCHE Bauer Advertising KG 561
wöchentliche Frauenzeitschriften GLÜCKS REVUE Hubert Burda Media 678
wöchentliche Frauenzeitschriften Laura Bauer Advertising KG 679
wöchentliche Frauenzeitschriften Lisa Hubert Burda Media 678
wöchentliche Frauenzeitschriften mach mal Pause Bauer Advertising KG 561
wöchentliche Frauenzeitschriften Mini Bauer Advertising KG 561
wöchentliche Frauenzeitschriften NEUE POST Bauer Advertising KG 679
wöchentliche Frauenzeitschriften neue woche Hubert Burda Media 679
wöchentliche Frauenzeitschriften Schöne WOCHE Bauer Advertising KG 561
wöchentliche Frauenzeitschriften tina Bauer Advertising KG 679
wöchentliche Frauenzeitschriften Viel Spaß Hubert Burda Media 678
Wohn- und Gartenzeitschriften A&W Architektur & Wohnen Jahreszeiten Verlag GmbH 60
Wohn- und Gartenzeitschriften ELLE DECORATION Hubert Burda Media 12
Wohn- und Gartenzeitschriften HÄUSER Gruner + Jahr GmbH & Co KG 49
Wohn- und Gartenzeitschriften Laura wohnen kreativ Bauer Advertising KG 156
Wohn- und Gartenzeitschriften Lisa Blumen & Pflanzen Hubert Burda Media 157
Wohn- und Gartenzeitschriften Lisa Wohnen & Dekorieren Hubert Burda Media 157
Wohn- und Gartenzeitschriften LIVING AT HOME Gruner + Jahr GmbH & Co KG 157
Wohn- und Gartenzeitschriften Mein schöner Garten Hubert Burda Media 157
Wohn- und Gartenzeitschriften SCHÖNER WOHNEN Gruner + Jahr GmbH & Co KG 157
Wohn- und Gartenzeitschriften selbst ist der Mann Bauer Advertising KG 157
Wohn- und Gartenzeitschriften Wohnen & Garten Hubert Burda Media 157
Wohn- und Gartenzeitschriften WOHNIDEE Bauer Advertising KG 157
Wohn- und Gartenzeitschriften ZUHAUSE WOHNEN Jahreszeiten Verlag GmbH 120
df %>%
  group_by(Titel, Gattung)%>%
  tally() %>%
  ggplot(aes(reorder(Titel,n),n, fill = Gattung)) +
  geom_col() +
  coord_flip() +
    ggthemes::theme_hc() +
  labs(x=NULL, y=NULL, title="Titel") +
  theme(legend.position = "right")

df %>%
  group_by(Gattung)%>%
  tally() %>%
  ggplot(aes(reorder(Gattung,n),n)) +
  geom_col() +
  coord_flip() +
  ggthemes::theme_hc() +
  labs(x=NULL, y=NULL, title = "Gattung")

types <- unique(df$Gattung)
i <- 6

df %>%
  filter(Gattung == types[i]) %>%
  mutate(date = calculate_week(issue, year)) %>%
  ggplot(aes(
    `Heft Nr.`
    #date 
    ,`Verkauf Gesamt`, 
    color=Titel, group=Titel)) +
  geom_line() +
  ggthemes::theme_hc() +
  labs(x="", color="", title = types[i]) +
  theme(axis.text.x = element_blank(),
        axis.ticks.x = element_blank())

i <- 12

df %>%
  filter(Gattung == types[i]) %>%
  mutate(date = calculate_week(issue, year)) %>%
  ggplot(aes(
    #`Heft Nr.`
    date 
    ,`Verkauf Gesamt`, 
    color=Titel, group=Titel)) +
  geom_line() +
  ggthemes::theme_hc() +
  labs(x="", color="", title = types[i]) 

i <- 2

df %>%
  filter(Gattung == types[i]) %>%
  mutate(date = calculate_week(issue, year)) %>%
  ggplot(aes(
    `Heft Nr.`
    #date 
    ,`Verkauf Gesamt`, 
    color=Titel, group=Titel)) +
  geom_line() +
  ggthemes::theme_hc() +
  labs(x="", color="", title = types[i]) +
  theme(axis.text.x = element_blank(),
         axis.ticks.x = element_blank())

i <- 13

df %>%
  filter(Gattung == types[i]) %>%
  mutate(date = calculate_week(issue, year)) %>%
  ggplot(aes(
    `Heft Nr.`
    #date 
    ,`Verkauf Gesamt`, 
    color=Titel, group=Titel)) +
  geom_line() +
  ggthemes::theme_hc() +
  labs(x="", color="", title = types[i]) +
  theme(axis.text.x = element_blank(),
        axis.ticks.x = element_blank())

Group all magazines by Issue Nr. (Heftnummer) to use all of them in the cluster analysis

# drop magazines with data less than 200 data points
drops <- df %>%
  group_by(Titel) %>%
  tally(sort = T) %>%
  filter(n < 200) %>%
  select(Titel) 

drops <- drops$Titel

tempdf <- df %>%
  filter(! Titel %in% drops) %>%
  group_by(year, issue, Titel) %>%
  summarise(sales = sum(`Verkauf Gesamt`)) %>%
  ungroup() %>%
  mutate(
    date=paste0(issue, "/", year)
  ) %>%
  spread(Titel, sales)

tempdf <- na.omit(tempdf)
p <- tempdf %>%
  select(-year, -issue) %>%
  gather(Titel, sales, -date) %>%
  ggplot(aes(date,sales,color=Titel, group=Titel)) +
  geom_line() +
  ggthemes::theme_hc() +
  labs(x="", color="", title="Residuals") +
  theme(legend.position = "none", 
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank())

plotly::ggplotly(p)
tempdf <- tempdf %>%
  select(- year, - issue, - date)

1. Prewhitening / ARIMA

\[ y_t = \beta_1y_{t-1}+\beta_2y_{t-2}+...+\epsilon_{it} \]

# ARIMA estimation
mag <- names(tempdf)

for (i in seq(1:length(mag))) {
  
  # get the time series
  #selected <- tempdf[, -which(names(tempdf) ==  mag[i])]
  # estimate auto arima
  temp <- auto.arima(tempdf[,i], ic="bic")
  
  # create dataframe with the residuals
  if (i == 1) {
   resid <- cbind(temp$residuals) 
  } else {
    resid <- cbind(resid, temp$residuals) 
  }
}

colnames(resid) <- mag
p <- autoplot(resid) +
  geom_hline(yintercept = 0, color = "grey50") +
  ggthemes::theme_hc() +
  labs(y="residuals", x="", color = "") +
  theme(legend.position = "none")

plotly::ggplotly(p)

2. Calculate Corralation

3. Dissimilarity

\[ d_{ij} = 1-|\text{corr}_{ij}| \]

# as a measure of distance
df.dis <- 1 - abs(df.corr)
df_distance <- as.dist(df.dis)

4. Agglomerative clustering

Also known as AGNES (Agglomerative Nesting). It works in a bottom-up manner. That is, each object is initially considered as a single-element cluster (leaf). At each step of the algorithm, the two clusters that are the most similar are combined into a new bigger cluster (nodes). This procedure is iterated until all points are member of just one single big cluster (root). The result is a tree which can be plotted as a dendrogram.

Maximum or complete linkage clustering: This linkage method makes use of the maximum intercluster dissimilarity, which can be represented by

\[ D_{complete}(A,B) = \text{max} d_{ij} \]

where A and B are two distinct clusters and dij is the chosen dissimilarity measure. As can be seen from this equation , the method computes all pairwise dissimilarities between the elements in cluster 1 and the elements in cluster 2, and considers the largest value (i.e., maximum value) of these dissimilarities as the distance between the two clusters. It tends to produce more compact clusters.

hc1 <- hclust(df_distance, method = "complete")

Dendogram

plot(hc1, main="", xlab="", cex = 0.6)

In the dendrogram displayed above, each leaf corresponds to one observation. As we move up the tree, observations that are similar to each other are combined into branches, which are themselves fused at a higher height. The height of the fusion, provided on the vertical axis, indicates the (dis)similarity between two observations in terms of our dissimilarity measure \(d_{ij}\).

As soon as we move up the tree, some of those leafs begin to fuse into branches. For instance, at a height of 0.6 the freundin and Für Sie form a cluster. This means that their adjusted quantity series show an empirical correlation of 0.4

5. Cutoff value

In order to delineate relevant markets, a suitable cutoff value has to be determined.

cut = 0.6
plot(hc1, cex = 0.6, xlab="", ylab="", main= paste("Cut at height =",cut))
rect.hclust(hc1, h = cut, border = 2:5)